<%
'VBS JSON 2.0.3
'Copyright (c) 2009 Topuz
'Under the MIT (MIT-LICENSE.txt) license.
Const JSON_OBJECT	= 0
Const JSON_ARRAY	= 1

class jsCore
	public Collection
	public Count
	public QuotedVars
	public Kind ' 0 = object, 1 = array

	private sub class_Initialize
		set Collection = server.createObject("Scripting.Dictionary")
		QuotedVars = true
		Count = 0
	End sub

	private sub class_Terminate
		set Collection = nothing
	End sub

	' counter
	private Property Get Counter
		Counter = Count
		Count = Count + 1
	End Property

	' - data maluplation
	' -- pair
	public Property Let Pair(p, v)
		if isNull(p) then p = Counter
		Collection(p) = v
	End Property

	public Property set Pair(p, v)
		if isNull(p) then p = Counter
		if TypeName(v) <> "jsCore" then
			err.Raise &hD, "class: class", "Incompatible types: '" & TypeName(v) & "'"
		end if
		set Collection(p) = v
	End Property

	public Default Property Get Pair(p)
		if isNull(p) then p = Count - 1
		if isObject(Collection(p)) then
			set Pair = Collection(p)
		else
			Pair = Collection(p)
		end if
	End Property
	' -- pair
	public sub Clean
		Collection.removeAll
	End sub

	public sub remove(vProp)
		Collection.remove vProp
	End sub
	' data maluplation

	' encoding
	function jsEncode(str)
		dim charmap(127), haystack()
		charmap(8)  = "\b"
		charmap(9)  = "\t"
		charmap(10) = "\n"
		charmap(12) = "\f"
		charmap(13) = "\r"
		charmap(34) = "\"""
		charmap(47) = "\/"
		charmap(92) = "\\"

		dim strlen : strlen = len(str) - 1
		redim haystack(strlen)

		dim i, charcode
		for i = 0 to strlen
			haystack(i) = mid(str, i + 1, 1)

			charcode = ascw(haystack(i)) and 65535
			if charcode < 127 then
				if not isEmpty(charmap(charcode)) then
					haystack(i) = charmap(charcode)
				elseif charcode < 32 then
					haystack(i) = "\u" & right("000" & hex(charcode), 4)
				end if
			else
				haystack(i) = "\u" & right("000" & hex(charcode), 4)
			end if
		next

		jsEncode = Join(haystack, "")
	end function

	' converting
	public function toJSON(vPair)
		select case VarType(vPair)
			case 0	' Empty
				toJSON = "null"
			case 1	' null
				toJSON = "null"
			case 7	' Date
				' toJSON = "new Date(" & (vPair - cdate(25569)) * 86400000 & ")"	' let in only utc time
				toJSON = """" & cstr(vPair) & """"
			case 8	' String
				toJSON = """" & jsEncode(vPair) & """"
			case 9	' Object
				dim bFI,i
				bFI = true
				if vPair.Kind then toJSON = toJSON & "[" else toJSON = toJSON & "{"
				for each i in vPair.Collection
					if bFI then bFI = false else toJSON = toJSON & ","

					if vPair.Kind then
						toJSON = toJSON & toJSON(vPair(i))
					else
						if QuotedVars then
							toJSON = toJSON & """" & i & """:" & toJSON(vPair(i))
						else
							toJSON = toJSON & i & ":" & toJSON(vPair(i))
						end if
					end if
				next
				if vPair.Kind then toJSON = toJSON & "]" else toJSON = toJSON & "}"
			case 11
				if vPair then toJSON = "true" else toJSON = "false"
			case 12, 8192, 8204
				toJSON = RenderArray(vPair, 1, "")
			case else
				toJSON = replace(vPair, ",", ".")
		End select
	end function

	function RenderArray(arr, depth, parent)
		dim first : first = LBound(arr, depth)
		dim last : last = ubound(arr, depth)

		dim index, rendered
		dim limiter : limiter = ","

		RenderArray = "["
		for index = first to last
			if index = last then
				limiter = ""
			End if

			on error resume next
			rendered = RenderArray(arr, depth + 1, parent & index & "," )

			if err = 9 then
				On error GoTo 0
				RenderArray = RenderArray & toJSON(Eval("arr(" & parent & index & ")")) & limiter
			else
				RenderArray = RenderArray & rendered & "" & limiter
			end if
		next
		RenderArray = RenderArray & "]"
	end function

	public Property Get jsString
		jsString = toJSON(Me)
	End Property

	sub flush
		if TypeName(response) <> "Empty" then
			response.write(jsString)
		elseif WScript <> Empty then
			WScript.Echo(jsString)
		end if
	End sub

	public function Clone
		set Clone = ColClone(Me)
	end function

	private function ColClone(core)
		dim jsc, i
		set jsc = new jsCore
		jsc.Kind = core.Kind
		for each i in core.Collection
			if isObject(core(i)) then
				set jsc(i) = ColClone(core(i))
			else
				jsc(i) = core(i)
			end if
		next
		set ColClone = jsc
	end function

end class

function jsObject
	set jsObject = new jsCore
	jsObject.Kind = JSON_OBJECT
end function

function jsArray
	set jsArray = new jsCore
	jsArray.Kind = JSON_ARRAY
end function

function toJSON(val)
	toJSON = (new jsCore).toJSON(val)
end function
%>